SGI Freeware 1999 August/SGI Freeware 1999 August.iso/dist/fw_xemacs.idb/usr/freeware/lib/xemacs-20.4/lisp/tl/char-table.el.z/char-table.el

Text File | 1998-05-21 | 5.0 KB | 191 lines

;;; char-table.el --- display table of charset

;; Copyright (C) 1996,1997 MORIOKA Tomohiko

;; Author: MORIOKA Tomohiko <[e-mail]>
;; Version: $Id: char-table.el,v 3.4 1997/06/29 05:05:23 morioka Exp $
;; Keywords: character, mule

;; This file is part of tl (Tiny Library).

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(defsubst char-position-to-string (charset r l &optional plane)
  (char-to-string
   (if plane
       (make-char charset plane (+ (* r 16) l))
     (make-char charset (+ (* r 16) l))
     )))

(defsubst char-table-1 (charset r l plane)
  (let* ((str (char-position-to-string charset r l plane))
     (lp (- 3 (string-width str)))
     (rp (/ lp 2)))
    (setq lp
      (if (= (mod lp 2) 0)
          rp
        (1+ rp)))
    (concat (make-string lp ? ) str (make-string rp ? ))
    ))

(defun insert-94-charset-table (charset &optional plane ofs)
  (if (null ofs)
      (setq ofs 0)
    )
  (insert (format
      "[%02x]$B("(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
      (or plane 0)))
  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
  (let ((j 2))
    (insert (format "%02x%x$B("(B   " (or plane 0) (* (+ j ofs) 16)))
    (let ((k 1))
      (while (< k 16)
    (insert (char-table-1 charset j k plane))
    (setq k (+ k 1))
    )
      (insert "\n")
      )
    (setq j 3)
    (while (< j 7)
      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
      (let ((k 0))
    (while (< k 16)
      (insert (char-table-1 charset j k plane))
      (setq k (+ k 1))
      )
    (insert "\n")
    )
      (setq j (+ j 1))
      )
    (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
    (let ((k 0))
      (while (< k 15)
    (insert (char-table-1 charset j k plane))
    (setq k (+ k 1))
    )
      (insert "\n")
      )
    ))

(defun insert-96-charset-table (charset &optional plane ofs)
  (if (null ofs)
      (setq ofs 0)
    )
  (insert (format
      "[%02x]$B("(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
      (or plane 0)))
  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
  (let ((j 2))
    (while (< j 8)
      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
      (let ((k 0))
    (while (< k 16)
      (insert (char-table-1 charset j k plane))
      (setq k (+ k 1))
      )
    (insert "\n")
    )
      (setq j (1+ j))
      )))

(defun insert-94x94-charset-table (charset)
  (insert-94-charset-table charset 33)
  (let ((i 34))
    (while (< i 127)
      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
      (insert-94-charset-table charset i)
      (setq i (1+ i))
      )))

(defun insert-96x96-charset-table (charset)
  (insert-96-charset-table charset 32)
  (let ((i 33))
    (while (< i 128)
      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
      (insert-96-charset-table charset i)
      (setq i (1+ i))
      )))

(defun insert-charset-table (charset)
  "Insert character table of CHARSET."
  (insert "$B(,(,(8(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
  (let ((cc (charset-chars charset))
    (cd (charset-dimension charset))
    )
    (cond ((= cd 1)
       (cond ((= cc 94)
          (insert-94-charset-table charset)
          )
         ((= cc 96)
          (insert-96-charset-table charset)
          ))
       )
      ((= cd 2)
       (cond ((= cc 94)
          (insert-94x94-charset-table charset)
          )
         ((= cc 96)
          (insert-96x96-charset-table charset)
          ))
       )))
  (insert "$B(,(,(:(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
  )

;;;###autoload
(defun view-charset (charset)
  "Display character table of CHARSET."
  (interactive
   (list
    (let ((charset-alist
       (mapcar (function
            (lambda (charset)
              (cons (charset-doc-string charset) charset)
              ))
           (charset-list))))
      (cdr (assoc (completing-read "What charset: "
                   charset-alist nil t nil)
          charset-alist))
      )))
  (let* ((desc (charset-doc-string charset))
     (buf (concat "*Charset table for "
              (charset-doc-string charset)
              "*")))
    (unless (get-buffer buf)
      (let ((the-buf (current-buffer)))
    (set-buffer (get-buffer-create buf))
    (insert (format "%s (%s)\n" desc charset))
    (let ((msg (format "Generating char table for %s..." desc)))
      (message msg)
      (insert-charset-table charset)
      (message "%s Done." msg)
      )
    (set-buffer-modified-p nil)
    (goto-char (point-min))
    (set-buffer the-buf)
    ))
    (view-buffer buf)
    ))


;;; @ end
;;;

(provide 'char-table)

;;; char-table.el ends here